home *** CD-ROM | disk | FTP | other *** search
/ AGA Toolkit '97 / The AGA Toolkit '97.iso / miscellaneous / science / maths / calc / source / codegen.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-09-07  |  42.7 KB  |  1,991 lines
  1. /*
  2.  * Copyright (c) 1994 David I. Bell
  3.  * Permission is granted to use, distribute, or modify this source,
  4.  * provided that this copyright notice remains intact.
  5.  *
  6.  * Module to generate opcodes from the input tokens.
  7.  */
  8.  
  9. #include "calc.h"
  10. #include "token.h"
  11. #include "symbol.h"
  12. #include "label.h"
  13. #include "opcodes.h"
  14. #include "string.h"
  15. #include "func.h"
  16. #include "config.h"
  17.  
  18. static BOOL rdonce;    /* TRUE => do not reread this file */
  19.  
  20. FUNC *curfunc;
  21.  
  22. static BOOL getfilename(), getid();
  23. static void getshowcommand(), getfunction(), getbody(), getdeclarations();
  24. static void getstatement(), getobjdeclaration(), getobjvars();
  25. static void getmatdeclaration(), getsimplebody(), getonedeclaration();
  26. static void getcondition(), getmatargs(), getelement(), usesymbol();
  27. static void definesymbol(), getcallargs();
  28. static void do_changedir();
  29. static int getexprlist(), getassignment(), getaltcond(), getorcond();
  30. static int getandcond(), getrelation(), getsum(), getproduct();
  31. static int getorexpr(), getandexpr(), getshiftexpr(), getterm();
  32. static int getidexpr();
  33. static long getinitlist();
  34.  
  35.  
  36. /*
  37.  * Read all the commands from an input file.
  38.  * These are either declarations, or else are commands to execute now.
  39.  * In general, commands are terminated by newlines or semicolons.
  40.  * Exceptions are function definitions and escaped newlines.
  41.  * Commands are read and executed until the end of file.
  42.  * The toplevel flag indicates whether we are at the top interactive level.
  43.  */
  44. void
  45. getcommands(toplevel)
  46.     BOOL toplevel;
  47. {
  48.     char name[PATHSIZE+1];    /* program name */
  49.  
  50.     if (!toplevel)
  51.         enterfilescope();
  52.     for (;;) {
  53.         (void) tokenmode(TM_NEWLINES);
  54.         switch (gettoken()) {
  55.  
  56.         case T_DEFINE:
  57.             getfunction();
  58.             break;
  59.  
  60.         case T_EOF:
  61.             if (!toplevel)
  62.                 exitfilescope();
  63.             return;
  64.  
  65.         case T_HELP:
  66.             if (!getfilename(name, FALSE, NULL)) {
  67.                 strcpy(name, DEFAULTCALCHELP);
  68.             }
  69.             givehelp(name);
  70.             break;
  71.  
  72.         case T_READ:
  73.             if (!getfilename(name, TRUE, &rdonce))
  74.                 break;
  75.             switch (opensearchfile(name,calcpath,CALCEXT,rdonce)) {
  76.             case 0:
  77.                 getcommands(FALSE);
  78.                 break;
  79.             case 1:
  80.                 /* previously read and -once was given */
  81.                 break;
  82.             default:
  83.                 scanerror(T_NULL, "Cannot open \"%s\"\n", name);
  84.                 break;
  85.             }
  86.             break;
  87.  
  88.         case T_WRITE:
  89.             if (!getfilename(name, TRUE, NULL))
  90.                 break;
  91.             if (writeglobals(name))
  92.                 scanerror(T_NULL, "Error writing \"%s\"\n", name);
  93.             break;
  94.  
  95.         case T_SHOW:
  96.             rescantoken();
  97.             getshowcommand();
  98.             break;
  99.         case T_CD:
  100.             do_changedir();
  101.             break;
  102.         case T_NEWLINE:
  103.         case T_SEMICOLON:
  104.             break;
  105.  
  106.         default:
  107.             rescantoken();
  108.             initstack();
  109.             if (evaluate(FALSE))
  110.                 updateoldvalue(curfunc);
  111.         }
  112.     }
  113. }
  114.  
  115.  
  116. /*
  117.  * Evaluate a line of statements.
  118.  * This is done by treating the current line as a function body,
  119.  * compiling it, and then executing it.  Returns TRUE if the line
  120.  * successfully compiled and executed.  The last expression result
  121.  * is saved in the f_savedvalue element of the current function.
  122.  * The nestflag variable should be FALSE for the outermost evaluation
  123.  * level, and TRUE for all other calls (such as the 'eval' function).
  124.  * The function name begins with an asterisk to indicate specialness.
  125.  */
  126. BOOL
  127. evaluate(nestflag)
  128.     BOOL nestflag;        /* TRUE if this is a nested evaluation */
  129. {
  130.     char *funcname;
  131.     BOOL gotstatement;
  132.  
  133.     funcname = (nestflag ? "**" : "*");
  134.     beginfunc(funcname, nestflag);
  135.     gotstatement = FALSE;
  136.     for (;;) {
  137.         switch (gettoken()) {
  138.             case T_SEMICOLON:
  139.                 break;
  140.  
  141.             case T_NEWLINE:
  142.             case T_EOF:
  143.                 goto done;
  144.  
  145.             case T_GLOBAL:
  146.             case T_LOCAL:
  147.             case T_STATIC:
  148.                 if (gotstatement) {
  149.                     scanerror(T_SEMICOLON, "Declarations must be used before code");
  150.                     return FALSE;
  151.                 }
  152.                 rescantoken();
  153.                 getdeclarations();
  154.                 break;
  155.  
  156.             default:
  157.                 rescantoken();
  158.                 getstatement(NULL_LABEL, NULL_LABEL,
  159.                     NULL_LABEL, NULL_LABEL);
  160.                 gotstatement = TRUE;
  161.         }
  162.     }
  163.  
  164. done:
  165.     addop(OP_UNDEF);
  166.     addop(OP_RETURN);
  167.     checklabels();
  168.     if (errorcount)
  169.         return FALSE;
  170.     calculate(curfunc, 0);
  171.     return TRUE;
  172. }
  173.  
  174.  
  175. /*
  176.  * Get a function declaration.
  177.  * func = name '(' '' | name [ ',' name] ... ')' simplebody
  178.  *    | name '(' '' | name [ ',' name] ... ')' body.
  179.  */
  180. static void
  181. getfunction()
  182. {
  183.     char *name;        /* parameter name */
  184.     int type;        /* type of token read */
  185.  
  186.     (void) tokenmode(TM_DEFAULT);
  187.     if (gettoken() != T_SYMBOL) {
  188.         scanerror(T_NULL, "Function name expected");
  189.         return;
  190.     }
  191.     beginfunc(tokenstring(), FALSE);
  192.     enterfuncscope();
  193.     if (gettoken() != T_LEFTPAREN) {
  194.         scanerror(T_SEMICOLON, "Left parenthesis expected for function");
  195.         return;
  196.     }
  197.     for (;;) {
  198.         type = gettoken();
  199.         if (type == T_RIGHTPAREN)
  200.             break;
  201.         if (type != T_SYMBOL) {
  202.             scanerror(T_COMMA, "Bad function definition");
  203.             return;
  204.         }
  205.         name = tokenstring();
  206.         switch (symboltype(name)) {
  207.             case SYM_UNDEFINED:
  208.             case SYM_GLOBAL:
  209.             case SYM_STATIC:
  210.                 (void) addparam(name);
  211.                 break;
  212.             default:
  213.                 scanerror(T_NULL, "Parameter \"%s\" is already defined", name);
  214.         }
  215.         type = gettoken();
  216.         if (type == T_RIGHTPAREN)
  217.             break;
  218.         if (type != T_COMMA) {
  219.             scanerror(T_COMMA, "Bad function definition");
  220.             return;
  221.         }
  222.     }
  223.     switch (gettoken()) {
  224.         case T_ASSIGN:
  225.             rescantoken();
  226.             getsimplebody();
  227.             break;
  228.         case T_LEFTBRACE:
  229.             rescantoken();
  230.             getbody(NULL_LABEL, NULL_LABEL, NULL_LABEL,
  231.                 NULL_LABEL, TRUE);
  232.             break;
  233.         default:
  234.             scanerror(T_NULL,
  235.                 "Left brace or equals sign expected for function");
  236.             return;
  237.     }
  238.     addop(OP_UNDEF);
  239.     addop(OP_RETURN);
  240.     endfunc();
  241.     exitfuncscope();
  242. }
  243.  
  244.  
  245. /*
  246.  * Get a simple assignment style body for a function declaration.
  247.  * simplebody = '=' assignment '\n'.
  248.  */
  249. static void
  250. getsimplebody()
  251. {
  252.     if (gettoken() != T_ASSIGN) {
  253.         scanerror(T_SEMICOLON, "Missing equals for simple function body");
  254.         return;
  255.     }
  256.     (void) tokenmode(TM_NEWLINES);
  257.     (void) getexprlist();
  258.     addop(OP_RETURN);
  259.     if (gettoken() != T_SEMICOLON)
  260.         rescantoken();
  261.     if (gettoken() != T_NEWLINE)
  262.         scanerror(T_NULL, "Illegal function definition");
  263. }
  264.  
  265.  
  266. /*
  267.  * Get the body of a function, or a subbody of a function.
  268.  * body = '{' [ declarations ] ... [ statement ] ... '}'
  269.  *    | [ declarations ] ... [statement ] ... '\n'
  270.  */
  271. static void
  272. getbody(contlabel, breaklabel, nextcaselabel, defaultlabel, toplevel)
  273.     LABEL *contlabel, *breaklabel, *nextcaselabel, *defaultlabel;
  274.     BOOL toplevel;
  275. {
  276.     BOOL gotstatement;    /* TRUE if seen a real statement yet */
  277.     int oldmode;
  278.  
  279.     if (gettoken() != T_LEFTBRACE) {
  280.         scanerror(T_SEMICOLON, "Missing left brace for function body");
  281.         return;
  282.     }
  283.     oldmode = tokenmode(TM_DEFAULT);
  284.     gotstatement = FALSE;
  285.     while (TRUE) {
  286.         switch (gettoken()) {
  287.         case T_RIGHTBRACE:
  288.             (void) tokenmode(oldmode);
  289.             return;
  290.  
  291.         case T_GLOBAL:
  292.         case T_LOCAL:
  293.         case T_STATIC:
  294.             if (!toplevel) {
  295.                 scanerror(T_SEMICOLON, "Declarations must be at the top of the function");
  296.                 return;
  297.             }
  298.             if (gotstatement) {
  299.                 scanerror(T_SEMICOLON, "Declarations must be used before code");
  300.                 return;
  301.             }
  302.             rescantoken();
  303.             getdeclarations();
  304.             break;
  305.  
  306.         default:
  307.             rescantoken();
  308.             getstatement(contlabel, breaklabel, nextcaselabel, defaultlabel);
  309.             gotstatement = TRUE;
  310.         }
  311.     }
  312. }
  313.  
  314.  
  315. /*
  316.  * Get a line of possible local, global, or static variable declarations.
  317.  * declarations = { LOCAL | GLOBAL | STATIC } onedeclaration
  318.  *    [ ',' onedeclaration ] ... ';'.
  319.  */
  320. static void
  321. getdeclarations()
  322. {
  323.     int type;
  324.  
  325.     type = gettoken();
  326.  
  327.     if ((type != T_LOCAL) && (type != T_GLOBAL) && (type != T_STATIC)) {
  328.         rescantoken();
  329.         return;
  330.     }
  331.  
  332.     while (TRUE) {
  333.         getonedeclaration(type);
  334.  
  335.         switch (gettoken()) {
  336.             case T_COMMA:
  337.                 continue;
  338.  
  339.             case T_NEWLINE:
  340.             case T_SEMICOLON:
  341.                 return;
  342.  
  343.             default:
  344.                 scanerror(T_SEMICOLON, "Bad syntax in declaration statement");
  345.                 return;
  346.         }
  347.     }
  348. }
  349.  
  350.  
  351. /*
  352.  * Get a single declaration of a symbol of the specified type.
  353.  * onedeclaration = name [ '=' getassignment ]
  354.  *    | 'obj' type name [ '=' objvalues ]
  355.  *    | 'mat' name '[' matargs ']' [ '=' matvalues ].
  356.  */
  357. static void
  358. getonedeclaration(type)
  359.     int type;
  360. {
  361.     char *name;        /* name of symbol seen */
  362.     int symtype;        /* type of symbol */
  363.     int vartype;        /* type of variable being defined */
  364.     LABEL label;
  365.  
  366.     switch (type) {
  367.         case T_LOCAL:
  368.             symtype = SYM_LOCAL;
  369.             break;
  370.         case T_GLOBAL:
  371.             symtype = SYM_GLOBAL;
  372.             break;
  373.         case T_STATIC:
  374.             symtype = SYM_STATIC;
  375.             clearlabel(&label);
  376.             addoplabel(OP_INITSTATIC, &label);
  377.             break;
  378.         default:
  379.             symtype = SYM_UNDEFINED;
  380.             break;
  381.     }
  382.  
  383.     vartype = gettoken();
  384.     switch (vartype) {
  385.         case T_SYMBOL:
  386.             name = tokenstring();
  387.             definesymbol(name, symtype);
  388.             break;
  389.  
  390.         case T_MAT:
  391.             addopone(OP_DEBUG, linenumber());
  392.             getmatdeclaration(symtype);
  393.             if (symtype == SYM_STATIC)
  394.                 setlabel(&label);
  395.             return;
  396.  
  397.         case T_OBJ:
  398.             addopone(OP_DEBUG, linenumber());
  399.             getobjdeclaration(symtype);
  400.             if (symtype == SYM_STATIC)
  401.                 setlabel(&label);
  402.             return;
  403.  
  404.         default:
  405.             scanerror(T_COMMA, "Bad syntax for declaration");
  406.             return;
  407.     }
  408.  
  409.     if (gettoken() != T_ASSIGN) {
  410.         rescantoken();
  411.         if (symtype == SYM_STATIC)
  412.             setlabel(&label);
  413.         return;
  414.     }
  415.  
  416.     /*
  417.      * Initialize the variable with the expression.  If the variable is
  418.      * static, arrange for the initialization to only be done once.
  419.      */
  420.     addopone(OP_DEBUG, linenumber());
  421.     usesymbol(name, FALSE);
  422.     getassignment();
  423.     addop(OP_ASSIGNPOP);
  424.     if (symtype == SYM_STATIC)
  425.         setlabel(&label);
  426. }
  427.  
  428.  
  429. /*
  430.  * Get a statement.
  431.  * statement = IF condition statement [ELSE statement]
  432.  *    | FOR '(' [assignment] ';' [assignment] ';' [assignment] ')' statement
  433.  *    | WHILE condition statement
  434.  *    | DO statement WHILE condition ';'
  435.  *    | SWITCH condition '{' [caseclause] ... '}'
  436.  *    | CONTINUE ';'
  437.  *    | BREAK ';'
  438.  *    | RETURN assignment ';'
  439.  *    | GOTO label ';'
  440.  *    | MAT name '[' value [ ':' value ] [',' value [ ':' value ] ] ']' ';'
  441.  *    | OBJ type '{' arg [ ',' arg ] ... '}' ] ';'
  442.  *    | OBJ type name [ ',' name ] ';'
  443.  *    | PRINT assignment [, assignment ] ... ';'
  444.  *    | QUIT [ string ] ';'
  445.  *    | SHOW item ';'
  446.  *    | body
  447.  *    | assignment ';'
  448.  *    | label ':' statement
  449.  *    | ';'.
  450.  */
  451. static void
  452. getstatement(contlabel, breaklabel, nextcaselabel, defaultlabel)
  453.     LABEL *contlabel;    /* label for continue statement */
  454.     LABEL *breaklabel;    /* label for break statement */
  455.     LABEL *nextcaselabel;    /* label for next case statement */
  456.     LABEL *defaultlabel;    /* label for default case */
  457. {
  458.     LABEL label1, label2, label3, label4;    /* locations for jumps */
  459.     int type;
  460.     BOOL printeol;
  461.  
  462.     addopone(OP_DEBUG, linenumber());
  463.     switch (gettoken()) {
  464.     case T_NEWLINE:
  465.     case T_SEMICOLON:
  466.         return;
  467.  
  468.     case T_RIGHTBRACE:
  469.         scanerror(T_NULL, "Extraneous right brace");
  470.         return;
  471.  
  472.     case T_CONTINUE:
  473.         if (contlabel == NULL_LABEL) {
  474.             scanerror(T_SEMICOLON, "CONTINUE not within FOR, WHILE, or DO");
  475.             return;
  476.         }
  477.         addoplabel(OP_JUMP, contlabel);
  478.         break;
  479.  
  480.     case T_BREAK:
  481.         if (breaklabel == NULL_LABEL) {
  482.             scanerror(T_SEMICOLON, "BREAK not within FOR, WHILE, or DO");
  483.             return;
  484.         }
  485.         addoplabel(OP_JUMP, breaklabel);
  486.         break;
  487.  
  488.     case T_GOTO:
  489.         if (gettoken() != T_SYMBOL) {
  490.             scanerror(T_SEMICOLON, "Missing label in goto");
  491.             return;
  492.         }
  493.         addop(OP_JUMP);
  494.         addlabel(tokenstring());
  495.         break;
  496.  
  497.     case T_RETURN:
  498.         switch (gettoken()) {
  499.             case T_NEWLINE:
  500.             case T_SEMICOLON:
  501.                 addop(OP_UNDEF);
  502.                 addop(OP_RETURN);
  503.                 return;
  504.             default:
  505.                 rescantoken();
  506.                 (void) getexprlist();
  507.                 if (curfunc->f_name[0] == '*')
  508.                     addop(OP_SAVE);
  509.                 addop(OP_RETURN);
  510.         }
  511.         break;
  512.  
  513.     case T_LEFTBRACE:
  514.         rescantoken();
  515.         getbody(contlabel, breaklabel, nextcaselabel, defaultlabel, FALSE);
  516.         return;
  517.  
  518.     case T_IF:
  519.         clearlabel(&label1);
  520.         clearlabel(&label2);
  521.         getcondition();
  522.         addoplabel(OP_JUMPEQ, &label1);
  523.         getstatement(contlabel, breaklabel, NULL_LABEL, NULL_LABEL);
  524.         if (gettoken() != T_ELSE) {
  525.             setlabel(&label1);
  526.             rescantoken();
  527.             return;
  528.         }
  529.         addoplabel(OP_JUMP, &label2);
  530.         setlabel(&label1);
  531.         getstatement(contlabel, breaklabel, NULL_LABEL, NULL_LABEL);
  532.         setlabel(&label2);
  533.         return;
  534.  
  535.     case T_FOR:    /* for (a; b; c) x */
  536.         clearlabel(&label1);
  537.         clearlabel(&label2);
  538.         clearlabel(&label3);
  539.         clearlabel(&label4);
  540.         contlabel = NULL_LABEL;
  541.         breaklabel = &label4;
  542.         if (gettoken() != T_LEFTPAREN) {
  543.             scanerror(T_SEMICOLON, "Left parenthesis expected");
  544.             return;
  545.         }
  546.         if (gettoken() != T_SEMICOLON) {    /* have 'a' part */
  547.             rescantoken();
  548.             (void) getexprlist();
  549.             addop(OP_POP);
  550.             if (gettoken() != T_SEMICOLON) {
  551.                 scanerror(T_SEMICOLON, "Missing semicolon");
  552.                 return;
  553.             }
  554.         }
  555.         if (gettoken() != T_SEMICOLON) {    /* have 'b' part */
  556.             setlabel(&label1);
  557.             contlabel = &label1;
  558.             rescantoken();
  559.             (void) getexprlist();
  560.             addoplabel(OP_JUMPNE, &label3);
  561.             addoplabel(OP_JUMP, breaklabel);
  562.             if (gettoken() != T_SEMICOLON) {
  563.                 scanerror(T_SEMICOLON, "Missing semicolon");
  564.                 return;
  565.             }
  566.         }
  567.         if (gettoken() != T_RIGHTPAREN) {    /* have 'c' part */
  568.             if (label1.l_offset <= 0)
  569.                 addoplabel(OP_JUMP, &label3);
  570.             setlabel(&label2);
  571.             contlabel = &label2;
  572.             rescantoken();
  573.             (void) getexprlist();
  574.             addop(OP_POP);
  575.             if (label1.l_offset > 0)
  576.                 addoplabel(OP_JUMP, &label1);
  577.             if (gettoken() != T_RIGHTPAREN) {
  578.                 scanerror(T_SEMICOLON, "Right parenthesis expected");
  579.                 return;
  580.             }
  581.         }
  582.         setlabel(&label3);
  583.         if (contlabel == NULL_LABEL)
  584.             contlabel = &label3;
  585.         getstatement(contlabel, breaklabel, NULL_LABEL, NULL_LABEL);
  586.         addoplabel(OP_JUMP, contlabel);
  587.         setlabel(breaklabel);
  588.         return;
  589.  
  590.     case T_WHILE:
  591.         contlabel = &label1;
  592.         breaklabel = &label2;
  593.         clearlabel(contlabel);
  594.         clearlabel(breaklabel);
  595.         setlabel(contlabel);
  596.         getcondition();
  597.         addoplabel(OP_JUMPEQ, breaklabel);
  598.         getstatement(contlabel, breaklabel, NULL_LABEL, NULL_LABEL);
  599.         addoplabel(OP_JUMP, contlabel);
  600.         setlabel(breaklabel);
  601.         return;
  602.  
  603.     case T_DO:
  604.         contlabel = &label1;
  605.         breaklabel = &label2;
  606.         clearlabel(contlabel);
  607.         clearlabel(breaklabel);
  608.         clearlabel(&label3);
  609.         setlabel(&label3);
  610.         getstatement(contlabel, breaklabel, NULL_LABEL, NULL_LABEL);
  611.         if (gettoken() != T_WHILE) {
  612.             scanerror(T_SEMICOLON, "WHILE keyword expected for DO statement");
  613.             return;
  614.         }
  615.         setlabel(contlabel);
  616.         getcondition();
  617.         addoplabel(OP_JUMPNE, &label3);
  618.         setlabel(breaklabel);
  619.         return;
  620.  
  621.     case T_SWITCH:
  622.         breaklabel = &label1;
  623.         nextcaselabel = &label2;
  624.         defaultlabel = &label3;
  625.         clearlabel(breaklabel);
  626.         clearlabel(nextcaselabel);
  627.         clearlabel(defaultlabel);
  628.         getcondition();
  629.         if (gettoken() != T_LEFTBRACE) {
  630.             scanerror(T_SEMICOLON, "Missing left brace for switch statement");
  631.             return;
  632.         }
  633.         addoplabel(OP_JUMP, nextcaselabel);
  634.         rescantoken();
  635.         getstatement(contlabel, breaklabel, nextcaselabel, defaultlabel);
  636.         addoplabel(OP_JUMP, breaklabel);
  637.         setlabel(nextcaselabel);
  638.         if (defaultlabel->l_offset > 0)
  639.             addoplabel(OP_JUMP, defaultlabel);
  640.         else
  641.             addop(OP_POP);
  642.         setlabel(breaklabel);
  643.         return;
  644.  
  645.     case T_CASE:
  646.         if (nextcaselabel == NULL_LABEL) {
  647.             scanerror(T_SEMICOLON, "CASE not within SWITCH statement");
  648.             return;
  649.         }
  650.         clearlabel(&label1);
  651.         addoplabel(OP_JUMP, &label1);
  652.         setlabel(nextcaselabel);
  653.         clearlabel(nextcaselabel);
  654.         (void) getexprlist();
  655.         if (gettoken() != T_COLON) {
  656.             scanerror(T_SEMICOLON, "Colon expected after CASE expression");
  657.             return;
  658.         }
  659.         addoplabel(OP_CASEJUMP, nextcaselabel);
  660.         setlabel(&label1);
  661.         getstatement(contlabel, breaklabel, nextcaselabel, defaultlabel);
  662.         return;
  663.  
  664.     case T_DEFAULT:
  665.         if (gettoken() != T_COLON) {
  666.             scanerror(T_SEMICOLON, "Colon expected after DEFAULT keyword");
  667.             return;
  668.         }
  669.         if (defaultlabel == NULL_LABEL) {
  670.             scanerror(T_SEMICOLON, "DEFAULT not within SWITCH statement");
  671.             return;
  672.         }
  673.         if (defaultlabel->l_offset > 0) {
  674.             scanerror(T_SEMICOLON, "Multiple DEFAULT clauses in SWITCH");
  675.             return;
  676.         }
  677.         clearlabel(&label1);
  678.         addoplabel(OP_JUMP, &label1);
  679.         setlabel(defaultlabel);
  680.         addop(OP_POP);
  681.         setlabel(&label1);
  682.         getstatement(contlabel, breaklabel, nextcaselabel, defaultlabel);
  683.         return;
  684.  
  685.     case T_ELSE:
  686.         scanerror(T_SEMICOLON, "ELSE without preceeding IF");
  687.         return;
  688.  
  689.     case T_MAT:
  690.         getmatdeclaration(SYM_UNDEFINED);
  691.         break;
  692.  
  693.     case T_OBJ:
  694.         getobjdeclaration(SYM_UNDEFINED);
  695.         break;
  696.  
  697.     case T_PRINT:
  698.         printeol = TRUE;
  699.         for (;;) {
  700.             switch (gettoken()) {
  701.                 case T_RIGHTBRACE:
  702.                 case T_NEWLINE:
  703.                     rescantoken();
  704.                     /*FALLTHRU*/
  705.                 case T_SEMICOLON:
  706.                     if (printeol)
  707.                         addop(OP_PRINTEOL);
  708.                     return;
  709.                 case T_COLON:
  710.                     printeol = FALSE;
  711.                     break;
  712.                 case T_COMMA:
  713.                     printeol = TRUE;
  714.                     addop(OP_PRINTSPACE);
  715.                     break;
  716.                 case T_STRING:
  717.                     printeol = TRUE;
  718.                     addopptr(OP_PRINTSTRING, tokenstring());
  719.                     break;
  720.                 default:
  721.                     printeol = TRUE;
  722.                     rescantoken();
  723.                     (void) getassignment();
  724.                     addopone(OP_PRINT, (long) PRINT_NORMAL);
  725.             }
  726.         }
  727.  
  728.     case T_QUIT:
  729.         switch (gettoken()) {
  730.             case T_STRING:
  731.                 addopptr(OP_QUIT, tokenstring());
  732.                 break;
  733.             default:
  734.                 addopptr(OP_QUIT, NULL);
  735.                 rescantoken();
  736.         }
  737.         break;
  738.  
  739.     case T_SYMBOL:
  740.         if (nextchar() == ':') {    /****HACK HACK ****/
  741.             definelabel(tokenstring());
  742.             getstatement(contlabel, breaklabel, 
  743.                 NULL_LABEL, NULL_LABEL);
  744.             return;
  745.         }
  746.         reread();
  747.         /* fall into default case */
  748.  
  749.     default:
  750.         rescantoken();
  751.         type = getexprlist();
  752.         if (contlabel || breaklabel || (curfunc->f_name[0] != '*')) {
  753.             addop(OP_POP);
  754.             break;
  755.         }
  756.         addop(OP_SAVE);
  757.         if (isassign(type) || (curfunc->f_name[1] != '\0')) {
  758.             addop(OP_POP);
  759.             break;
  760.         }
  761.         addop(OP_PRINTRESULT);
  762.         break;
  763.     }
  764.     switch (gettoken()) {
  765.         case T_RIGHTBRACE:
  766.         case T_NEWLINE:
  767.         case T_EOF:
  768.             rescantoken();
  769.             break;
  770.         case T_SEMICOLON:
  771.             break;
  772.         default:
  773.             scanerror(T_SEMICOLON, "Semicolon expected");
  774.             break;
  775.     }
  776. }
  777.  
  778.  
  779. /*
  780.  * Read in an object declaration.
  781.  * This is of the following form:
  782.  *    OBJ type [ '{' id [ ',' id ] ... '}' ]  [ objlist ].
  783.  * The OBJ keyword has already been read.  Symtype is SYM_UNDEFINED if this
  784.  * is an OBJ statement, otherwise this is part of a declaration which will
  785.  * define new symbols with the specified type.
  786.  */
  787. static void
  788. getobjdeclaration(symtype)
  789.     int symtype;
  790. {
  791.     char *name;            /* name of object type */
  792.     int count;            /* number of elements */
  793.     int index;            /* current index */
  794.     int i;                /* loop counter */
  795.     BOOL err;            /* error flag */
  796.     int indices[MAXINDICES];    /* indices for elements */
  797.  
  798.     err = FALSE;
  799.     if (gettoken() != T_SYMBOL) {
  800.         scanerror(T_SEMICOLON, "Object type name missing");
  801.         return;
  802.     }
  803.     name = addliteral(tokenstring());
  804.     if (gettoken() != T_LEFTBRACE) {
  805.         rescantoken();
  806.         getobjvars(name, symtype);
  807.         return;
  808.     }
  809.     /*
  810.      * Read in the definition of the elements of the object.
  811.      */
  812.     count = 0;
  813.     for (;;) {
  814.         if (gettoken() != T_SYMBOL) {
  815.             scanerror(T_SEMICOLON, "Missing element name in OBJ statement");
  816.             return;
  817.         }
  818.         index = addelement(tokenstring());
  819.         for (i = 0; i < count; i++) {
  820.             if (indices[i] == index) {
  821.                 scanerror(T_NULL, "Duplicate element name \"%s\"", tokenstring());
  822.                 err = TRUE;
  823.                 break;
  824.             }
  825.         }
  826.         indices[count++] = index;
  827.         switch (gettoken()) {
  828.             case T_RIGHTBRACE:
  829.                 if (!err)
  830.                     (void) defineobject(name, indices, count);
  831.                 switch (gettoken()) {
  832.                     case T_SEMICOLON:
  833.                     case T_NEWLINE:
  834.                         rescantoken();
  835.                         return;
  836.                 }
  837.                 rescantoken();
  838.                 getobjvars(name, symtype);
  839.                 return;
  840.             case T_COMMA:
  841.             case T_SEMICOLON:
  842.             case T_NEWLINE:
  843.                 break;
  844.             default:
  845.                 scanerror(T_SEMICOLON, "Bad object element definition");
  846.                 return;
  847.         }
  848.     }
  849. }
  850.  
  851.  
  852. /*
  853.  * Routine to collect a set of variables for the specified object type
  854.  * and initialize them as being that type of object.
  855.  * Here
  856.  *    objlist = name initlist [ ',' name initlist ] ... ';'.
  857.  * If symtype is SYM_UNDEFINED, then this is an OBJ statement where the
  858.  * values can be any variable expression, and no symbols are to be defined.
  859.  * Otherwise this is part of a declaration, and the variables must be raw
  860.  * symbol names which are defined with the specified symbol type.
  861.  */
  862. static void
  863. getobjvars(name, symtype)
  864.     int symtype;
  865.     char *name;        /* object name */
  866. {
  867.     long index;        /* index for object */
  868.     char *symname;
  869.  
  870.     index = checkobject(name);
  871.     if (index < 0) {
  872.         scanerror(T_SEMICOLON, "Object %s has not been defined yet", name);
  873.         return;
  874.     }
  875.     for (;;) {
  876.         if (symtype == SYM_UNDEFINED)
  877.             (void) getidexpr(TRUE, TRUE);
  878.         else {
  879.             if (gettoken() != T_SYMBOL) {
  880.                 scanerror(T_SEMICOLON, "Missing object variable name");
  881.                 return;
  882.             }
  883.             symname = tokenstring();
  884.             definesymbol(symname, symtype);
  885.             usesymbol(symname, FALSE);
  886.         }
  887.         addopone(OP_OBJCREATE, index);
  888.         (void) getinitlist();
  889.         switch (gettoken()) {
  890.             case T_COMMA:
  891.                 break;
  892.             case T_SEMICOLON:
  893.             case T_NEWLINE:
  894.                 rescantoken();
  895.                 return;
  896.             default:
  897.                 scanerror(T_SEMICOLON, "Bad OBJ statement");
  898.                 return;
  899.         }
  900.     }
  901. }
  902.  
  903.  
  904. /*
  905.  * Read a matrix definition declaration for a one or more dimensional matrix.
  906.  * The MAT keyword has already been read.  This also handles an optional
  907.  * matrix initialization list enclosed in braces.  Symtype is SYM_UNDEFINED
  908.  * if this is part of a MAT statement which handles any variable expression.
  909.  * Otherwise this is part of a declaration and only a symbol name is allowed.
  910.  */
  911. static void
  912. getmatdeclaration(symtype)
  913.     int symtype;
  914. {
  915.     long dim;
  916.     long index;
  917.     long count;
  918.     long patchpc;
  919.     char *name;
  920.  
  921.     if (symtype == SYM_UNDEFINED)
  922.         (void) getidexpr(FALSE, TRUE);
  923.     else {
  924.         if (gettoken() != T_SYMBOL) {
  925.             scanerror(T_COMMA, "Missing matrix variable name");
  926.             return;
  927.         }
  928.         name = tokenstring();
  929.         definesymbol(name, symtype);
  930.         usesymbol(name, FALSE);
  931.     }
  932.  
  933.     if (gettoken() != T_LEFTBRACKET) {
  934.         scanerror(T_SEMICOLON, "Missing left bracket for MAT");
  935.         return;
  936.     }
  937.     dim = 1;
  938.  
  939.     /*
  940.      * If there are no bounds given for the matrix, then they must be
  941.      * implicitly defined by a list of initialization values.  Put in
  942.      * a dummy number in the opcode stream for the bounds and remember
  943.      * its location.  After we know how many values are in the list, we
  944.      * will patch the correct value back into the opcode.
  945.      */
  946.     if (gettoken() == T_RIGHTBRACKET) {
  947.         clearopt();
  948.         patchpc = curfunc->f_opcodecount + 1;
  949.         addopone(OP_NUMBER, (long) -1);
  950.         clearopt();
  951.         addop(OP_ZERO);
  952.         addopone(OP_MATCREATE, dim);
  953.         count = getinitlist();
  954.         if (count == 0) {
  955.             scanerror(T_NULL, "Initialization required for implicit matrix bounds");
  956.             return;
  957.         }
  958.         index = addqconstant(itoq(count - 1));
  959.         if (index < 0)
  960.             math_error("Cannot allocate constant");
  961.         curfunc->f_opcodes[patchpc] = index;
  962.         return;
  963.     }
  964.  
  965.     /*
  966.      * This isn't implicit, so we expect expressions for the bounds.
  967.      */
  968.     rescantoken();
  969.     while (TRUE) {
  970.         (void) getassignment();
  971.         switch (gettoken()) {
  972.             case T_RIGHTBRACKET:
  973.             case T_COMMA:
  974.                 rescantoken();
  975.                 addop(OP_ONE);
  976.                 addop(OP_SUB);
  977.                 addop(OP_ZERO);
  978.                 break;
  979.             case T_COLON:
  980.                 (void) getassignment();
  981.                 break;
  982.             default:
  983.                 rescantoken();
  984.         }
  985.         switch (gettoken()) {
  986.             case T_RIGHTBRACKET:
  987.                 if (gettoken() != T_LEFTBRACKET) {
  988.                     rescantoken();
  989.                     addopone(OP_MATCREATE, dim);
  990.                     (void) getinitlist();
  991.                     return;
  992.                 }
  993.                 /* proceed into comma case */
  994.                 /*FALLTHRU*/
  995.             case T_COMMA:
  996.                 if (++dim <= MAXDIM)
  997.                     break;
  998.                 scanerror(T_SEMICOLON, "Only %ld dimensions allowed", MAXDIM);
  999.                 return;
  1000.             default:
  1001.                 scanerror(T_SEMICOLON, "Illegal matrix definition");
  1002.                 return;
  1003.         }
  1004.     }
  1005. }
  1006.  
  1007.  
  1008. /*
  1009.  * Get an optional initialization list for a matrix or object definition.
  1010.  * Returns the number of elements that are in the list, or -1 on parse error.
  1011.  * This assumes that the address of a matrix or object variable is on the
  1012.  * stack, and so this routine will pop it off when complete.
  1013.  *    initlist = [ '=' '{' assignment [ ',' assignment ] ... '}' ].
  1014.  */
  1015. static long
  1016. getinitlist()
  1017. {
  1018.     long index;
  1019.     int oldmode;
  1020.  
  1021.     if (gettoken() != T_ASSIGN) {
  1022.         rescantoken();
  1023.         addop(OP_POP);
  1024.         return 0;
  1025.     }
  1026.  
  1027.     oldmode = tokenmode(TM_DEFAULT);
  1028.  
  1029.     if (gettoken() != T_LEFTBRACE) {
  1030.         scanerror(T_SEMICOLON, "Missing brace for initialization list");
  1031.         (void) tokenmode(oldmode);
  1032.         return -1;
  1033.     }
  1034.  
  1035.     for (index = 0; ; index++) {
  1036.         getassignment();
  1037.         addopone(OP_ELEMINIT, index);
  1038.         switch (gettoken()) {
  1039.             case T_COMMA:
  1040.                 continue;
  1041.  
  1042.             case T_RIGHTBRACE:
  1043.                 (void) tokenmode(oldmode);
  1044.                 addop(OP_POP);
  1045.                 return index + 1;
  1046.  
  1047.             default:
  1048.                 scanerror(T_SEMICOLON, "Bad initialization list");
  1049.                 (void) tokenmode(oldmode);
  1050.                 return -1;
  1051.         }
  1052.     }
  1053. }
  1054.  
  1055.  
  1056. /*
  1057.  * Get a condition.
  1058.  * condition = '(' assignment ')'.
  1059.  */
  1060. static void
  1061. getcondition()
  1062. {
  1063.     if (gettoken() != T_LEFTPAREN) {
  1064.         scanerror(T_SEMICOLON, "Missing left parenthesis for condition");
  1065.         return;
  1066.     }
  1067.     (void) getexprlist();
  1068.     if (gettoken() != T_RIGHTPAREN) {
  1069.         scanerror(T_SEMICOLON, "Missing right parenthesis for condition");
  1070.         return;
  1071.     }
  1072. }
  1073.  
  1074.  
  1075. /*
  1076.  * Get an expression list consisting of one or more expressions,
  1077.  * separated by commas.  The value of the list is that of the final expression.
  1078.  * This is the top level routine for parsing expressions.
  1079.  * Returns flags describing the type of assignment or expression found.
  1080.  * exprlist = assignment [ ',' assignment ] ...
  1081.  */
  1082. static int
  1083. getexprlist()
  1084. {
  1085.     int    type;
  1086.  
  1087.     type = getassignment();
  1088.     while (gettoken() == T_COMMA) {
  1089.         addop(OP_POP);
  1090.         (void) getassignment();
  1091.         type = EXPR_RVALUE;
  1092.     }
  1093.     rescantoken();
  1094.     return type;
  1095. }
  1096.  
  1097.  
  1098. /*
  1099.  * Get an assignment (or possibly just an expression).
  1100.  * Returns flags describing the type of assignment or expression found.
  1101.  * assignment = lvalue '=' assignment
  1102.  *    | lvalue '+=' assignment
  1103.  *    | lvalue '-=' assignment
  1104.  *    | lvalue '*=' assignment
  1105.  *    | lvalue '/=' assignment
  1106.  *    | lvalue '%=' assignment
  1107.  *    | lvalue '//=' assignment
  1108.  *    | lvalue '&=' assignment
  1109.  *    | lvalue '|=' assignment
  1110.  *    | lvalue '<<=' assignment
  1111.  *    | lvalue '>>=' assignment
  1112.  *    | lvalue '^=' assignment
  1113.  *    | lvalue '**=' assignment
  1114.  *    | orcond.
  1115.  */
  1116. static int
  1117. getassignment()
  1118. {
  1119.     int type;        /* type of expression */
  1120.     long op;        /* opcode to generate */
  1121.  
  1122.     type = getaltcond();
  1123.     switch (gettoken()) {
  1124.         case T_ASSIGN:        op = 0; break;
  1125.         case T_PLUSEQUALS:    op = OP_ADD; break;
  1126.         case T_MINUSEQUALS:    op = OP_SUB; break;
  1127.         case T_MULTEQUALS:    op = OP_MUL; break;
  1128.         case T_DIVEQUALS:    op = OP_DIV; break;
  1129.         case T_SLASHSLASHEQUALS: op = OP_QUO; break;
  1130.         case T_MODEQUALS:    op = OP_MOD; break;
  1131.         case T_ANDEQUALS:    op = OP_AND; break;
  1132.         case T_OREQUALS:    op = OP_OR; break;
  1133.         case T_LSHIFTEQUALS:     op = OP_LEFTSHIFT; break;
  1134.         case T_RSHIFTEQUALS:     op = OP_RIGHTSHIFT; break;
  1135.         case T_POWEREQUALS:    op = OP_POWER; break;
  1136.  
  1137.         case T_NUMBER:
  1138.         case T_IMAGINARY:
  1139.         case T_STRING:
  1140.         case T_SYMBOL:
  1141.         case T_OLDVALUE:
  1142.         case T_LEFTPAREN:
  1143.         case T_PLUSPLUS:
  1144.         case T_MINUSMINUS:
  1145.         case T_NOT:
  1146.             scanerror(T_NULL, "Missing operator");
  1147.             return type;
  1148.  
  1149.         default:
  1150.             rescantoken();
  1151.             return type;
  1152.     }
  1153.     if (isrvalue(type)) {
  1154.         scanerror(T_NULL, "Illegal assignment");
  1155.         (void) getassignment();
  1156.         return (EXPR_RVALUE | EXPR_ASSIGN);
  1157.     }
  1158.     writeindexop();
  1159.     if (op)
  1160.         addop(OP_DUPLICATE);
  1161.     (void) getassignment();
  1162.     if (op) {
  1163.         addop(op);
  1164.     }
  1165.     addop(OP_ASSIGN);
  1166.     return (EXPR_RVALUE | EXPR_ASSIGN);
  1167. }
  1168.  
  1169.  
  1170. /*
  1171.  * Get a possible conditional result expression (question mark).
  1172.  * Flags are returned indicating the type of expression found.
  1173.  * altcond = orcond [ '?' orcond ':' altcond ].
  1174.  */
  1175. static int
  1176. getaltcond()
  1177. {
  1178.     int type;        /* type of expression */
  1179.     LABEL donelab;        /* label for done */
  1180.     LABEL altlab;        /* label for alternate expression */
  1181.  
  1182.     type = getorcond();
  1183.     if (gettoken() != T_QUESTIONMARK) {
  1184.         rescantoken();
  1185.         return type;
  1186.     }
  1187.     clearlabel(&donelab);
  1188.     clearlabel(&altlab);
  1189.     addoplabel(OP_JUMPEQ, &altlab);
  1190.     (void) getorcond();
  1191.     if (gettoken() != T_COLON) {
  1192.         scanerror(T_SEMICOLON, "Missing colon for conditional expression");
  1193.         return EXPR_RVALUE;
  1194.     }
  1195.     addoplabel(OP_JUMP, &donelab);
  1196.     setlabel(&altlab);
  1197.     (void) getaltcond();
  1198.     setlabel(&donelab);
  1199.     return EXPR_RVALUE;
  1200. }
  1201.  
  1202.  
  1203. /*
  1204.  * Get a possible conditional or expression.
  1205.  * Flags are returned indicating the type of expression found.
  1206.  * orcond = andcond [ '||' andcond ] ...
  1207.  */
  1208. static int
  1209. getorcond()
  1210. {
  1211.     int type;        /* type of expression */
  1212.     LABEL donelab;        /* label for done */
  1213.  
  1214.     clearlabel(&donelab);
  1215.     type = getandcond();
  1216.     while (gettoken() == T_OROR) {
  1217.         addoplabel(OP_CONDORJUMP, &donelab);
  1218.         (void) getandcond();
  1219.         type = EXPR_RVALUE;
  1220.     }
  1221.     rescantoken();
  1222.     if (donelab.l_chain > 0)
  1223.         setlabel(&donelab);
  1224.     return type;
  1225. }
  1226.  
  1227.  
  1228. /*
  1229.  * Get a possible conditional and expression.
  1230.  * Flags are returned indicating the type of expression found.
  1231.  * andcond = relation [ '&&' relation ] ...
  1232.  */
  1233. static int
  1234. getandcond()
  1235. {
  1236.     int type;        /* type of expression */
  1237.     LABEL donelab;        /* label for done */
  1238.  
  1239.     clearlabel(&donelab);
  1240.     type = getrelation();
  1241.     while (gettoken() == T_ANDAND) {
  1242.         addoplabel(OP_CONDANDJUMP, &donelab);
  1243.         (void) getrelation();
  1244.         type = EXPR_RVALUE;
  1245.     }
  1246.     rescantoken();
  1247.     if (donelab.l_chain > 0)
  1248.         setlabel(&donelab);
  1249.     return type;
  1250. }
  1251.  
  1252.  
  1253. /*
  1254.  * Get a possible relation (equality or inequality), or just an expression.
  1255.  * Flags are returned indicating the type of relation found.
  1256.  * relation = sum '==' sum
  1257.  *    | sum '!=' sum
  1258.  *    | sum '<=' sum
  1259.  *    | sum '>=' sum
  1260.  *    | sum '<' sum
  1261.  *    | sum '>' sum
  1262.  *    | sum.
  1263.  */
  1264. static int
  1265. getrelation()
  1266. {
  1267.     int type;        /* type of expression */
  1268.     long op;        /* opcode to generate */
  1269.  
  1270.     type = getsum();
  1271.     switch (gettoken()) {
  1272.         case T_EQ: op = OP_EQ; break;
  1273.         case T_NE: op = OP_NE; break;
  1274.         case T_LT: op = OP_LT; break;
  1275.         case T_GT: op = OP_GT; break;
  1276.         case T_LE: op = OP_LE; break;
  1277.         case T_GE: op = OP_GE; break;
  1278.         default:
  1279.             rescantoken();
  1280.             return type;
  1281.     }
  1282.     (void) getsum();
  1283.     addop(op);
  1284.     return EXPR_RVALUE;
  1285. }
  1286.  
  1287.  
  1288. /*
  1289.  * Get an expression made up of sums of products.
  1290.  * Flags indicating the type of expression found are returned.
  1291.  * sum = product [ {'+' | '-'} product ] ...
  1292.  */
  1293. static int
  1294. getsum()
  1295. {
  1296.     int type;        /* type of expression found */
  1297.     long op;        /* opcode to generate */
  1298.  
  1299.     type = getproduct();
  1300.     for (;;) {
  1301.         switch (gettoken()) {
  1302.             case T_PLUS:    op = OP_ADD; break;
  1303.             case T_MINUS:    op = OP_SUB; break;
  1304.             default:
  1305.                 rescantoken();
  1306.                 return type;
  1307.         }
  1308.         (void) getproduct();
  1309.         addop(op);
  1310.         type = EXPR_RVALUE;
  1311.     }
  1312. }
  1313.  
  1314.  
  1315. /*
  1316.  * Get the product of arithmetic or expressions.
  1317.  * Flags indicating the type of expression found are returned.
  1318.  * product = orexpr [ {'*' | '/' | '//' | '%'} orexpr ] ...
  1319.  */
  1320. static int
  1321. getproduct()
  1322. {
  1323.     int type;        /* type of value found */
  1324.     long op;        /* opcode to generate */
  1325.  
  1326.     type = getorexpr();
  1327.     for (;;) {
  1328.         switch (gettoken()) {
  1329.             case T_MULT:    op = OP_MUL; break;
  1330.             case T_DIV:    op = OP_DIV; break;
  1331.             case T_MOD:    op = OP_MOD; break;
  1332.             case T_SLASHSLASH: op = OP_QUO; break;
  1333.             default:
  1334.                 rescantoken();
  1335.                 return type;
  1336.         }
  1337.         (void) getorexpr();
  1338.         addop(op);
  1339.         type = EXPR_RVALUE;
  1340.     }
  1341. }
  1342.  
  1343.  
  1344. /*
  1345.  * Get an expression made up of arithmetic or operators.
  1346.  * Flags indicating the type of expression found are returned.
  1347.  * orexpr = andexpr [ '|' andexpr ] ...
  1348.  */
  1349. static int
  1350. getorexpr()
  1351. {
  1352.     int type;        /* type of value found */
  1353.  
  1354.     type = getandexpr();
  1355.     while (gettoken() == T_OR) {
  1356.         (void) getandexpr();
  1357.         addop(OP_OR);
  1358.         type = EXPR_RVALUE;
  1359.     }
  1360.     rescantoken();
  1361.     return type;
  1362. }
  1363.  
  1364.  
  1365. /*
  1366.  * Get an expression made up of arithmetic and operators.
  1367.  * Flags indicating the type of expression found are returned.
  1368.  * andexpr = shiftexpr [ '&' shiftexpr ] ...
  1369.  */
  1370. static int
  1371. getandexpr()
  1372. {
  1373.     int type;        /* type of value found */
  1374.  
  1375.     type = getshiftexpr();
  1376.     while (gettoken() == T_AND) {
  1377.         (void) getshiftexpr();
  1378.         addop(OP_AND);
  1379.         type = EXPR_RVALUE;
  1380.     }
  1381.     rescantoken();
  1382.     return type;
  1383. }
  1384.  
  1385.  
  1386. /*
  1387.  * Get a shift or power expression.
  1388.  * Flags indicating the type of expression found are returned.
  1389.  * shift = term '^' shiftexpr
  1390.  *     | term '<<' shiftexpr
  1391.  *     | term '>>' shiftexpr
  1392.  *     | term.
  1393.  */
  1394. static int
  1395. getshiftexpr()
  1396. {
  1397.     int type;        /* type of value found */
  1398.     long op;        /* opcode to generate */
  1399.  
  1400.     type = getterm();
  1401.     switch (gettoken()) {
  1402.         case T_POWER:        op = OP_POWER; break;
  1403.         case T_LEFTSHIFT:    op = OP_LEFTSHIFT; break;
  1404.         case T_RIGHTSHIFT:     op = OP_RIGHTSHIFT; break;
  1405.         default:
  1406.             rescantoken();
  1407.             return type;
  1408.     }
  1409.     (void) getshiftexpr();
  1410.     addop(op);
  1411.     return EXPR_RVALUE;
  1412. }
  1413.  
  1414.  
  1415. /*
  1416.  * Get a single term.
  1417.  * Flags indicating the type of value found are returned.
  1418.  * term = lvalue
  1419.  *    | lvalue '[' assignment ']'
  1420.  *    | lvalue '++'
  1421.  *    | lvalue '--'
  1422.  *    | '++' lvalue
  1423.  *    | '--' lvalue
  1424.  *    | real_number
  1425.  *    | imaginary_number
  1426.  *    | '.'
  1427.  *    | string
  1428.  *    | '(' assignment ')'
  1429.  *    | function [ '(' [assignment  [',' assignment] ] ')' ]
  1430.  *    | '!' term
  1431.  *    | '+' term
  1432.  *    | '-' term.
  1433.  */
  1434. static int
  1435. getterm()
  1436. {
  1437.     int type;        /* type of term found */
  1438.  
  1439.     type = gettoken();
  1440.     switch (type) {
  1441.         case T_NUMBER:
  1442.             addopone(OP_NUMBER, tokennumber());
  1443.             type = (EXPR_RVALUE | EXPR_CONST);
  1444.             break;
  1445.  
  1446.         case T_IMAGINARY:
  1447.             addopone(OP_IMAGINARY, tokennumber());
  1448.             type = (EXPR_RVALUE | EXPR_CONST);
  1449.             break;
  1450.  
  1451.         case T_OLDVALUE:
  1452.             addop(OP_OLDVALUE);
  1453.             type = 0;
  1454.             break;
  1455.  
  1456.         case T_STRING:
  1457.             addopptr(OP_STRING, tokenstring());
  1458.             type = (EXPR_RVALUE | EXPR_CONST);
  1459.             break;
  1460.  
  1461.         case T_PLUSPLUS:
  1462.             if (isrvalue(getterm()))
  1463.                 scanerror(T_NULL, "Bad ++ usage");
  1464.             writeindexop();
  1465.             addop(OP_PREINC);
  1466.             type = (EXPR_RVALUE | EXPR_ASSIGN);
  1467.             break;
  1468.  
  1469.         case T_MINUSMINUS:
  1470.             if (isrvalue(getterm()))
  1471.                 scanerror(T_NULL, "Bad -- usage");
  1472.             writeindexop();
  1473.             addop(OP_PREDEC);
  1474.             type = (EXPR_RVALUE | EXPR_ASSIGN);
  1475.             break;
  1476.  
  1477.         case T_NOT:
  1478.             (void) getterm();
  1479.             addop(OP_NOT);
  1480.             type = EXPR_RVALUE;
  1481.             break;
  1482.  
  1483.         case T_MINUS:
  1484.             (void) getterm();
  1485.             addop(OP_NEGATE);
  1486.             type = EXPR_RVALUE;
  1487.             break;
  1488.  
  1489.         case T_PLUS:
  1490.             (void) getterm();
  1491.             type = EXPR_RVALUE;
  1492.             break;
  1493.  
  1494.         case T_LEFTPAREN:
  1495.             type = getexprlist();
  1496.             if (gettoken() != T_RIGHTPAREN)
  1497.                 scanerror(T_SEMICOLON, "Missing right parenthesis");
  1498.             break;
  1499.  
  1500.         case T_SYMBOL:
  1501.             rescantoken();
  1502.             type = getidexpr(TRUE, FALSE);
  1503.             break;
  1504.  
  1505.         case T_LEFTBRACKET:
  1506.             scanerror(T_NULL, "Bad index usage");
  1507.             type = 0;
  1508.             break;
  1509.  
  1510.         case T_PERIOD:
  1511.             scanerror(T_NULL, "Bad element reference");
  1512.             type = 0;
  1513.             break;
  1514.  
  1515.         default:
  1516.             if (iskeyword(type)) {
  1517.                 scanerror(T_NULL, "Expression contains reserved keyword");
  1518.                 type = 0;
  1519.                 break;
  1520.             }
  1521.             rescantoken();
  1522.             scanerror(T_NULL, "Missing expression");
  1523.             type = 0;
  1524.     }
  1525.     switch (gettoken()) {
  1526.         case T_PLUSPLUS:
  1527.             if (isrvalue(type))
  1528.                 scanerror(T_NULL, "Bad ++ usage");
  1529.             writeindexop();
  1530.             addop(OP_POSTINC);
  1531.             return (EXPR_RVALUE | EXPR_ASSIGN);
  1532.         case T_MINUSMINUS:
  1533.             if (isrvalue(type))
  1534.                 scanerror(T_NULL, "Bad -- usage");
  1535.             writeindexop();
  1536.             addop(OP_POSTDEC);
  1537.             return (EXPR_RVALUE | EXPR_ASSIGN);
  1538.         default:
  1539.             rescantoken();
  1540.             return type;
  1541.     }
  1542. }
  1543.  
  1544.  
  1545. /*
  1546.  * Read in an identifier expressions.
  1547.  * This is a symbol name followed by parenthesis, or by square brackets or
  1548.  * element refernces.  The symbol can be a global or a local variable name.
  1549.  * Returns the type of expression found.
  1550.  */
  1551. static int
  1552. getidexpr(okmat, autodef)
  1553.     BOOL okmat, autodef;
  1554. {
  1555.     int type;
  1556.     char name[SYMBOLSIZE+1];    /* symbol name */
  1557.  
  1558.     type = 0;
  1559.     if (!getid(name))
  1560.         return type;
  1561.     switch (gettoken()) {
  1562.         case T_LEFTPAREN:
  1563.             getcallargs(name);
  1564.             type = EXPR_RVALUE;
  1565.             break;
  1566.         case T_ASSIGN:
  1567.             autodef = TRUE;
  1568.             /* fall into default case */
  1569.         default:
  1570.             rescantoken();
  1571.             usesymbol(name, autodef);
  1572.     }
  1573.     /*
  1574.      * Now collect as many element references and matrix index operations
  1575.      * as there are following the id.
  1576.      */
  1577.     for (;;) {
  1578.         switch (gettoken()) {
  1579.             case T_LEFTBRACKET:
  1580.                 rescantoken();
  1581.                 if (!okmat)
  1582.                     return type;
  1583.                 getmatargs();
  1584.                 type = 0;
  1585.                 break;
  1586.             case T_PERIOD:
  1587.                 getelement();
  1588.                 type = 0;
  1589.                 break;
  1590.             case T_LEFTPAREN:
  1591.                 scanerror(T_NULL, "Function calls not allowed as expressions");
  1592.             default:
  1593.                 rescantoken();
  1594.                 return type;
  1595.         }
  1596.     }
  1597. }
  1598.  
  1599.  
  1600. /*
  1601.  * Read in a filename for a read or write command.
  1602.  * Both quoted and unquoted filenames are handled here.
  1603.  * The name must be terminated by an end of line or semicolon.
  1604.  * Returns TRUE if the filename was successfully parsed.
  1605.  */
  1606. static BOOL
  1607. getfilename(name, msg_ok, once)
  1608.     char name[PATHSIZE+1];
  1609.     BOOL msg_ok;        /* TRUE => ok to print error messages */
  1610.     BOOL *once;        /* non-NULL => set to TRUE of -once read */
  1611. {
  1612.     /* look at the next token */
  1613.     (void) tokenmode(TM_NEWLINES | TM_ALLSYMS);
  1614.     switch (gettoken()) {
  1615.         case T_STRING:
  1616.         case T_SYMBOL:
  1617.             break;
  1618.         default:
  1619.             if (msg_ok)
  1620.                 scanerror(T_SEMICOLON, "Filename expected");
  1621.             return FALSE;
  1622.     }
  1623.     strcpy(name, tokenstring());
  1624.  
  1625.     /* determine if we care about a possible -once option */
  1626.     if (once != NULL) {
  1627.         /* we care about a possible -once option */
  1628.         if (strcmp(name, "-once") == 0) {
  1629.             /* -once option found */
  1630.             *once = TRUE;
  1631.             /* look for the filename */
  1632.             switch (gettoken()) {
  1633.                 case T_STRING:
  1634.                 case T_SYMBOL:
  1635.                     break;
  1636.                 default:
  1637.                     if (msg_ok)
  1638.                         scanerror(T_SEMICOLON, 
  1639.                             "Filename expected");
  1640.                     return FALSE;
  1641.             }
  1642.             strcpy(name, tokenstring());
  1643.         } else {
  1644.             *once = FALSE;
  1645.         }
  1646.     }
  1647.  
  1648.     /* look at the next token */
  1649.     switch (gettoken()) {
  1650.         case T_SEMICOLON:
  1651.         case T_NEWLINE:
  1652.         case T_EOF:
  1653.             break;
  1654.         default:
  1655.             if (msg_ok)
  1656.                 scanerror(T_SEMICOLON, 
  1657.                     "Missing semicolon after filename");
  1658.             return FALSE;
  1659.     }
  1660.     return TRUE;
  1661. }
  1662.  
  1663.  
  1664. /*
  1665.  * Read the show command and display useful information.
  1666.  */
  1667. static void
  1668. getshowcommand()
  1669. {
  1670.     char name[SYMBOLSIZE+1];
  1671.  
  1672.     int tok = gettoken ();
  1673.     switch ((tok = gettoken ())) {
  1674.         case T_NULL:
  1675.         case T_NEWLINE:
  1676.         case T_SEMICOLON:
  1677. #ifdef CALC_MALLOC
  1678.             scanerror(T_SEMICOLON, "SHOW command must be followed by one of: builtin, global, function, objfunc or memory");
  1679. #else
  1680.             scanerror(T_SEMICOLON, "SHOW command must be followed by one of: builtin, global, function or objfunc");
  1681. #endif
  1682.             return;
  1683.         case T_SYMBOL:
  1684.             strcpy(name, tokenstring());
  1685.             break;
  1686.         default:
  1687.             scanerror(T_SEMICOLON, "Bad syntax for SHOW command");
  1688.             return;
  1689.     }
  1690.     switch (gettoken()) {
  1691.         case T_NEWLINE:
  1692.         case T_SEMICOLON:
  1693.             break;
  1694.         default:
  1695.             scanerror(T_SEMICOLON, "Bad syntax for SHOW command");
  1696.     }
  1697.     switch ((int) stringindex("builtins\000builtin\000globals\000global\000functions\000function\000objfuncs\000objfunc\000memory\0", name)) {
  1698.         case 1:
  1699.         case 2:
  1700.             showbuiltins();
  1701.             break;
  1702.         case 3:
  1703.         case 4:
  1704.             showglobals();
  1705.             break;
  1706.         case 5:
  1707.         case 6:
  1708.             showfunctions();
  1709.             break;
  1710.         case 7:
  1711.         case 8:
  1712.             showobjfuncs();
  1713.             break;
  1714.         case 9:
  1715.             mem_stats("");
  1716.             break;
  1717.         default:
  1718.             scanerror(T_NULL, "Unknown SHOW parameter \"%s\"", name);
  1719.     }
  1720. }
  1721.  
  1722.  
  1723. /*
  1724.  * Read in a set of matrix index arguments, surrounded with square brackets.
  1725.  * This also handles double square brackets for 'fast indexing'.
  1726.  */
  1727. static void
  1728. getmatargs()
  1729. {
  1730.     int dim;
  1731.  
  1732.     if (gettoken() != T_LEFTBRACKET) {
  1733.         scanerror(T_NULL, "Matrix indexing expected");
  1734.         return;
  1735.     }
  1736.     /*
  1737.      * Parse all levels of the array reference
  1738.      * Look for the 'fast index' first.
  1739.      */
  1740.     if (gettoken() == T_LEFTBRACKET) {
  1741.         (void) getassignment();
  1742.         if ((gettoken() != T_RIGHTBRACKET) ||
  1743.             (gettoken() != T_RIGHTBRACKET)) {
  1744.                 scanerror(T_NULL, "Bad fast index usage");
  1745.                 return;
  1746.         }
  1747.         addop(OP_FIADDR);
  1748.         return;
  1749.     }
  1750.     rescantoken();
  1751.     /*
  1752.      * Normal indexing with the indexes separated by commas.
  1753.      * Initialize the flag in the opcode to assume that the array
  1754.      * element will only be referenced for reading.  If the parser
  1755.      * finds that the element will be referenced for writing, then
  1756.      * it will call writeindexop to change the flag in the opcode.
  1757.      */
  1758.     dim = 1;
  1759.     for (;;) {
  1760.         (void) getassignment();
  1761.         switch (gettoken()) {
  1762.             case T_RIGHTBRACKET:
  1763.                 if (gettoken() != T_LEFTBRACKET) {
  1764.                     rescantoken();
  1765.                     addoptwo(OP_INDEXADDR, (long) dim,
  1766.                         (long) FALSE);
  1767.                     return;
  1768.                 }
  1769.                 /* proceed into comma case */
  1770.                 /*FALLTHRU*/
  1771.             case T_COMMA:
  1772.                 if (++dim > MAXDIM)
  1773.                     scanerror(T_NULL, "Too many dimensions for array reference");
  1774.                 break;
  1775.             default:
  1776.                 rescantoken();
  1777.                 scanerror(T_NULL, "Missing right bracket in array reference");
  1778.                 return;
  1779.         }
  1780.     }
  1781. }
  1782.  
  1783.  
  1784. /*
  1785.  * Get an element of an object reference.
  1786.  * The leading period which introduces the element has already been read.
  1787.  */
  1788. static void
  1789. getelement()
  1790. {
  1791.     long index;
  1792.     char name[SYMBOLSIZE+1];
  1793.  
  1794.     if (!getid(name))
  1795.         return;
  1796.     index = findelement(name);
  1797.     if (index < 0) {
  1798.         scanerror(T_NULL, "Element \"%s\" is undefined", name);
  1799.         return;
  1800.     }
  1801.     addopone(OP_ELEMADDR, index);
  1802. }
  1803.  
  1804.  
  1805. /*
  1806.  * Read in a single symbol name and copy its value into the given buffer.
  1807.  * Returns TRUE if a valid symbol id was found.
  1808.  */
  1809. static BOOL
  1810. getid(buf)
  1811.     char buf[SYMBOLSIZE+1];
  1812. {
  1813.     int type;
  1814.  
  1815.     type = gettoken();
  1816.     if (iskeyword(type)) {
  1817.         scanerror(T_NULL, "Reserved keyword used as symbol name");
  1818.         type = T_SYMBOL;
  1819.     }
  1820.     if (type != T_SYMBOL) {
  1821.         rescantoken();
  1822.         scanerror(T_NULL, "Symbol name expected");
  1823.         *buf = '\0';
  1824.         return FALSE;
  1825.     }
  1826.     strncpy(buf, tokenstring(), SYMBOLSIZE);
  1827.     buf[SYMBOLSIZE] = '\0';
  1828.     return TRUE;
  1829. }
  1830.  
  1831.  
  1832. /*
  1833.  * Define a symbol name to be of the specified symbol type.  This also checks
  1834.  * to see if the symbol was already defined in an incompatible manner.
  1835.  */
  1836. static void
  1837. definesymbol(name, symtype)
  1838.     int symtype;
  1839.     char *name;
  1840. {
  1841.     switch (symboltype(name)) {
  1842.         case SYM_UNDEFINED:
  1843.         case SYM_GLOBAL:
  1844.         case SYM_STATIC:
  1845.             if (symtype == SYM_LOCAL)
  1846.                 (void) addlocal(name);
  1847.             else
  1848.                 (void) addglobal(name, (symtype == SYM_STATIC));
  1849.             break;
  1850.  
  1851.         case SYM_PARAM:
  1852.         case SYM_LOCAL:
  1853.             scanerror(T_COMMA, "Variable \"%s\" is already defined", name);
  1854.             return;
  1855.     }
  1856.  
  1857. }
  1858.  
  1859.  
  1860. /*
  1861.  * Check a symbol name to see if it is known and generate code to reference it.
  1862.  * The symbol can be either a parameter name, a local name, or a global name.
  1863.  * If autodef is true, we automatically define the name as a global symbol
  1864.  * if it is not yet known.
  1865.  */
  1866. static void
  1867. usesymbol(name, autodef)
  1868.     char *name;        /* symbol name to be checked */
  1869.     BOOL autodef;
  1870. {
  1871.     switch (symboltype(name)) {
  1872.         case SYM_LOCAL:
  1873.             addopone(OP_LOCALADDR, (long) findlocal(name));
  1874.             return;
  1875.         case SYM_PARAM:
  1876.             addopone(OP_PARAMADDR, (long) findparam(name));
  1877.             return;
  1878.         case SYM_GLOBAL:
  1879.         case SYM_STATIC:
  1880.             addopptr(OP_GLOBALADDR, (char *) findglobal(name));
  1881.             return;
  1882.     }
  1883.     /*
  1884.      * The symbol is not yet defined.
  1885.      * If we are at the top level and we are allowed to, then define it.
  1886.      */
  1887.     if ((curfunc->f_name[0] != '*') || !autodef) {
  1888.         scanerror(T_NULL, "\"%s\" is undefined", name);
  1889.         return;
  1890.     }
  1891.     (void) addglobal(name, FALSE);
  1892.     addopptr(OP_GLOBALADDR, (char *) findglobal(name));
  1893. }
  1894.  
  1895.  
  1896. /*
  1897.  * Get arguments for a function call.
  1898.  * The name and beginning parenthesis has already been seen.
  1899.  * callargs = [ [ '&' ] assignment  [',' [ '&' ] assignment] ] ')'.
  1900.  */
  1901. static void
  1902. getcallargs(name)
  1903.     char *name;        /* name of function */
  1904. {
  1905.     long index;        /* function index */
  1906.     long op;        /* opcode to add */
  1907.     int argcount;        /* number of arguments */
  1908.     int type;
  1909.     BOOL addrflag;
  1910.  
  1911.     op = OP_CALL;
  1912.     index = getbuiltinfunc(name);
  1913.     if (index < 0) {
  1914.         op = OP_USERCALL;
  1915.         index = adduserfunc(name);
  1916.     }
  1917.     if (gettoken() == T_RIGHTPAREN) {
  1918.         if (op == OP_CALL)
  1919.             builtincheck(index, 0);
  1920.         addopfunction(op, index, 0);
  1921.         return;
  1922.     }
  1923.     rescantoken();
  1924.     argcount = 0;
  1925.     for (;;) {
  1926.         argcount++;
  1927.         addrflag = (gettoken() == T_AND);
  1928.         if (!addrflag)
  1929.             rescantoken();
  1930.         type = getassignment();
  1931.         if (addrflag) {
  1932.             if (isrvalue(type))
  1933.                 scanerror(T_NULL, "Taking address of non-variable");
  1934.             writeindexop();
  1935.         }
  1936.         if (!addrflag && (op != OP_CALL))
  1937.             addop(OP_GETVALUE);
  1938.         switch (gettoken()) {
  1939.             case T_RIGHTPAREN:
  1940.                 if (op == OP_CALL)
  1941.                     builtincheck(index, argcount);
  1942.                 addopfunction(op, index, argcount);
  1943.                 return;
  1944.             case T_COMMA:
  1945.                 break;
  1946.             default:
  1947.                 scanerror(T_SEMICOLON, "Missing right parenthesis in function call");
  1948.                 return;
  1949.         }
  1950.     }
  1951. }
  1952.  
  1953.  
  1954. /*
  1955.  * Change the current directory.  If no directory is given, assume home.
  1956.  */
  1957. static void 
  1958. do_changedir()
  1959. {
  1960.     char *p;
  1961.  
  1962.     /* look at the next token */
  1963.     (void) tokenmode(TM_NEWLINES | TM_ALLSYMS);
  1964.  
  1965.     /* determine the new directory */
  1966.     switch (gettoken()) {
  1967.     case T_NULL:
  1968.     case T_NEWLINE:
  1969.     case T_SEMICOLON:
  1970.         p = getenv("HOME");
  1971.         break;
  1972.     default:
  1973.         p = tokenstring();
  1974.         if (p == NULL) {
  1975.             p = getenv("HOME");
  1976.         }
  1977.         break;
  1978.     }
  1979.     if (p == NULL) {
  1980.         fprintf(stderr, "Cannot determine HOME directory\n");
  1981.     }
  1982.  
  1983.     /* change to that directory */
  1984.     if (chdir(p)) {
  1985.         perror(p);
  1986.     }
  1987.     return;
  1988. }
  1989.  
  1990. /* END CODE */
  1991.